COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	BEGIN	"HEAP SORT"
C00004 ENDMK
C⊗;
BEGIN	"HEAP SORT"
	REQUIRE "ABBREV[SYS,BGB]" SOURCE_FILE;
	REQUIRE "RANDOM[SYS,BGB]" SOURCE_FILE;
	REQUIRE "TIMER[SYS,BGB]" SOURCE_FILE;

	INTEGER ARRAY A[1:10000];

PROCEDURE HEAPSORT (INTEGER ARRAY A; INTEGER N);
BEGIN	"HEAPSORT"
	INTEGER I,J,K;
	INTEGER X,Q;
α PHASE ONE, PUT 'EM UNDER THE HEAP & BIGGIES TRICKLE UP;
	FOR K←2 STEP 1 UNTIL N DO
	BEGIN
		I←K;
		X←A[K];
		WHILE I>1 ∧ X>A[J←I%2] DO
		BEGIN A[I]←A[J]; I←J END;
		A[I]←X;
	END;
α PHASE TWO, TAKE 'EM OFF THE TOP & PROMOTE SUBORDINATES;
	FOR K←N STEP -1 UNTIL 2 DO
	BEGIN
		X←A[K];A[K]←A[1];I←1;
		WHILE (J←2*I)<K DO
		BEGIN
			IF A[J+1]>A[J] ∧ (J+1)<K THEN J←J+1;
			IF X≥A[J] THEN DONE ELSE
			BEGIN A[I]←A[J];I←J;END;
		END;
		A[I]←X;
	END;
END	"HEAPSORT";

	INTEGER Q;
	FOR Q←1 STEP 1 UNTIL 1000 DO A[Q]←1000*RANDOM;
	INTIME;
	HEAPSORT(A,1000);
	FOR Q←1 STEP 1 UNTIL 1000-1 DO
	IF A[Q]>A[Q+1] THEN BEGIN OUTSTR("SORT ERROR ! ");INCHRW;END;
	OUTIME;
	INCHRW;
END	"HEAP SORT";